home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / ranlib / advnst.f next >
Text File  |  1996-07-19  |  2KB  |  81 lines
  1.       SUBROUTINE advnst(k)
  2. C**********************************************************************
  3. C
  4. C     SUBROUTINE ADVNST(K)
  5. C               ADV-a-N-ce ST-ate
  6. C
  7. C     Advances the state  of  the current  generator  by 2^K values  and
  8. C     resets the initial seed to that value.
  9. C
  10. C     This is  a  transcription from   Pascal to  Fortran    of  routine
  11. C     Advance_State from the paper
  12. C
  13. C     L'Ecuyer, P. and  Cote, S. "Implementing  a  Random Number Package
  14. C     with  Splitting   Facilities."  ACM  Transactions  on Mathematical
  15. C     Software, 17:98-111 (1991)
  16. C
  17. C
  18. C                              Arguments
  19. C
  20. C
  21. C     K -> The generator is advanced by2^K values
  22. C                                   INTEGER K
  23. C
  24. C**********************************************************************
  25. C     .. Parameters ..
  26.       INTEGER numg
  27.       PARAMETER (numg=32)
  28. C     ..
  29. C     .. Scalar Arguments ..
  30.       INTEGER k
  31. C     ..
  32. C     .. Scalars in Common ..
  33.       INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
  34. C     ..
  35. C     .. Arrays in Common ..
  36.       INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
  37.      +        lg2(numg)
  38.       LOGICAL qanti(numg)
  39. C     ..
  40. C     .. Local Scalars ..
  41.       INTEGER g,i,ib1,ib2
  42. C     ..
  43. C     .. External Functions ..
  44.       INTEGER mltmod
  45.       LOGICAL qrgnin
  46.       EXTERNAL mltmod,qrgnin
  47. C     ..
  48. C     .. External Subroutines ..
  49.       EXTERNAL getcgn,setsd
  50. C     ..
  51. C     .. Common blocks ..
  52.       COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
  53.      +       cg2,qanti
  54. C     ..
  55. C     .. Save statement ..
  56.       SAVE /globe/
  57. C     ..
  58. C     .. Executable Statements ..
  59. C     Abort unless random number generator initialized
  60.       IF (qrgnin()) GO TO 10
  61.       WRITE (*,*) ' ADVNST called before random number generator ',
  62.      +  ' initialized -- abort!'
  63.       CALL XSTOPX
  64.      + (' ADVNST called before random number generator initialized')
  65.  
  66.    10 CALL getcgn(g)
  67. C
  68.       ib1 = a1
  69.       ib2 = a2
  70.       DO 20,i = 1,k
  71.           ib1 = mltmod(ib1,ib1,m1)
  72.           ib2 = mltmod(ib2,ib2,m2)
  73.    20 CONTINUE
  74.       CALL setsd(mltmod(ib1,cg1(g),m1),mltmod(ib2,cg2(g),m2))
  75. C
  76. C     NOW, IB1 = A1**K AND IB2 = A2**K
  77. C
  78.       RETURN
  79.  
  80.       END
  81.